home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Profiler.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-11  |  15.7 KB  |  452 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 11 Jul 94
  5. Syntax10b.Scn.Fnt
  6. FoldElems
  7. MODULE Profiler;    (* profiler for block frequencies / HM  
  8. IMPORT Display, Oberon, Input, Fonts, Texts, TextFrames, Files, Viewers, MenuViewers;
  9. CONST
  10.     nKeys = 13;    (*number of keywords*)
  11.     maxCounters = 1000;    (*max. number of block counters*)
  12.     Name = ARRAY 32 OF CHAR;
  13.     Counter* = RECORD
  14.         n*, beg, end: LONGINT;
  15.     END;
  16.     Module* = POINTER TO ModDesc;
  17.     ModDesc* = RECORD
  18.         name: Name;
  19.         c*: POINTER TO ARRAY OF Counter;
  20.         next: Module
  21.     END;
  22.     SourceFrame = POINTER TO SourceFrameDesc;
  23.     CounterFrame = POINTER TO CounterFrameDesc;
  24.     SourceFrameDesc = RECORD (TextFrames.FrameDesc)
  25.         ctrFrame: CounterFrame
  26.     END;
  27.     CounterFrameDesc = RECORD (TextFrames.FrameDesc)
  28.         mod: Module;
  29.         srcFrame: SourceFrame;
  30.         counters: INTEGER;
  31.         c: POINTER TO ARRAY OF Counter
  32.     END;
  33.     c*: ARRAY maxCounters OF Counter;
  34.     nextCT: INTEGER;    (*index of next free counter*)
  35.     firstMod: Module;
  36.     stack: ARRAY 64 OF LONGINT;
  37.     sp: INTEGER;
  38.     key: ARRAY nKeys, 16 OF CHAR;
  39.     inPos, outPos, begPos: LONGINT;
  40.     level, returnLevel, procCtr: INTEGER;
  41.     inCode, caseBegin, inWith, hasImports: BOOLEAN;
  42.     compiler: ARRAY 32 OF CHAR;
  43.     neutralize: Oberon.ControlMsg;
  44.     R: Texts.Reader;
  45.     w: Texts.Writer;
  46.     src: Texts.Text;
  47.     ch: CHAR;
  48. (*--------------------------- basic routines -----------------------------------*)
  49. PROCEDURE NewMod (name: Name);    
  50.     VAR m, last: Module; i: INTEGER;
  51. BEGIN
  52.     m := firstMod; 
  53.     WHILE (m # NIL) & (name # m.name) DO last := m; m := m.next END;
  54.     IF m # NIL THEN
  55.         IF m = firstMod THEN firstMod := m.next ELSE last.next := m.next END
  56.     END;
  57.     NEW(m); m.next := firstMod; firstMod := m;
  58.     m.name := name;
  59.     IF nextCT > 0 THEN
  60.         NEW(m.c, nextCT);
  61.         FOR i := 0 TO nextCT-1 DO
  62.             m.c[i].beg := c[i].beg; m.c[i].end := c[i].end; m.c[i].n := 0
  63.         END
  64. END NewMod;
  65. PROCEDURE NewRange (pos: LONGINT; VAR n: INTEGER);    
  66. BEGIN
  67.     n := nextCT; INC(nextCT); c[n].beg := pos; stack[sp] := n; INC(sp)
  68. END NewRange;
  69. PROCEDURE EndRange (pos: LONGINT);    
  70.     VAR n: LONGINT;
  71. BEGIN
  72.     DEC(sp); n := stack[sp]; IF pos = c[n].beg THEN INC(pos) END; c[n].end := pos; c[n].n := 0
  73. END EndRange;
  74. (*---------------------------- instrumentation ---------------------------------*)
  75. PROCEDURE PutS (s: ARRAY OF CHAR);    
  76. BEGIN Texts.WriteString(w, s)
  77. END PutS;
  78. PROCEDURE PutI (x: LONGINT);    
  79. BEGIN Texts.WriteInt(w, x, 0)
  80. END PutI;
  81. PROCEDURE Get;    
  82. BEGIN Texts.Read(R, ch); INC(inPos); INC(outPos)
  83. END Get;
  84. PROCEDURE Insert (at: LONGINT);    
  85. BEGIN
  86.     outPos := outPos + w.buf.len; Texts.Insert(src, at, w.buf);
  87.     Texts.OpenReader(R, src, outPos) (*ch still the same*)
  88. END Insert;
  89. PROCEDURE StartRange (VAR c: INTEGER);    
  90. BEGIN
  91.     NewRange(inPos, c);
  92.     PutS("INC(CM.c["); PutI(c); PutS("].n);"); Insert(outPos)
  93. END StartRange;
  94. PROCEDURE GetName (VAR name: Name);    
  95.     VAR i: INTEGER;
  96. BEGIN
  97.     WHILE ch = " " DO Get END;
  98.     IF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN
  99.         i := 0;
  100.         WHILE (ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z") DO
  101.             name[i] := ch; INC(i); Get
  102.         END;
  103.         name[i] := 0X
  104.     ELSE name := ""
  105. END GetName;
  106. PROCEDURE ReadName;    
  107.     VAR len, ct: INTEGER; iPos, oPos: LONGINT; id: Name;
  108.     PROCEDURE Key(id: ARRAY OF CHAR): INTEGER;    
  109.         VAR i, j, m: INTEGER;
  110.     BEGIN
  111.         i := 0; j := nKeys - 1;
  112.         REPEAT
  113.             m := (i+j) DIV 2;
  114.             IF id < key[m] THEN j := m - 1 ELSE i := m + 1 END
  115.         UNTIL i > j;
  116.         IF (j < 0) OR (key[j] # id) THEN RETURN -1 ELSE RETURN j END
  117.     END Key;
  118.     PROCEDURE ImportProfiler;    
  119.         VAR s: Texts.Scanner;
  120.     BEGIN
  121.         Texts.OpenScanner(s, src, 0);
  122.         REPEAT Texts.Scan(s) UNTIL s.s = "MODULE";
  123.         REPEAT Texts.Scan(s) UNTIL (s.class = Texts.Char) & (s.c = ";");
  124.         PutS("IMPORT Profiler; VAR CM: Profiler.Module;");
  125.         Insert(Texts.Pos(s)-1);
  126.         hasImports := TRUE
  127.     END ImportProfiler;
  128. BEGIN
  129.     len := 0;
  130.     REPEAT
  131.         id[len] := ch; INC(len); Get
  132.     UNTIL ~((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z"));
  133.     id[len] := 0X;
  134.     CASE Key(id) OF
  135.      -1: (*no keyword*)
  136.     | 0: (*BEGIN*)
  137.             inCode := TRUE; begPos := outPos; StartRange(procCtr);
  138.             IF ~hasImports THEN ImportProfiler END
  139.     | 1, 6, 8, 10: (*DO, LOOP, REPEAT, THEN*)
  140.             StartRange(ct); INC(level)
  141.     | 2: (*ELSE*)
  142.             EndRange(inPos - 5); StartRange(ct)
  143.     | 3, 11: (*ELSIF, UNTIL*)
  144.             EndRange(inPos - 6); DEC(level)
  145.     | 4: (*END*)
  146.             IF level > 0 THEN (*end of statement*)
  147.                 EndRange(inPos - 4);
  148.                 IF level <= returnLevel THEN EndRange(inPos); PutS("; "); StartRange(ct) END;
  149.                 DEC(level); IF level = 0 THEN returnLevel := 0 END
  150.             ELSE
  151.                 iPos := inPos - 4; oPos := outPos - 4; GetName(id);
  152.                 IF id # "" THEN (*end of procedure or module*)
  153.                     IF procCtr < 0 THEN (*missing BEGIN*)
  154.                         NewRange(iPos, procCtr); begPos := oPos + 6;
  155.                         PutS("BEGIN INC(CM.c["); PutI(procCtr); PutS("].n)")
  156.                     END;
  157.                     EndRange(iPos);
  158.                     Insert(oPos);
  159.                     WHILE ch = " " DO Get END;
  160.                     IF ch = "." THEN 
  161.                         NewMod(id); PutS("Profiler.GetModule('"); PutS(id); PutS("', CM);"); Insert(begPos)
  162.                     END;
  163.                     inCode := FALSE; returnLevel := 0; procCtr := -1
  164.                 END
  165.             END
  166.     | 5: (*IMPORT*)
  167.             WHILE ch # ";" DO Get END;
  168.             PutS(", Profiler"); Insert(outPos-1);
  169.             PutS("VAR CM: Profiler.Module;"); Insert(outPos);
  170.             hasImports := TRUE
  171.     | 7: (*OF*)
  172.             caseBegin := inCode
  173.     | 9: (*RETURN*)
  174.             returnLevel := level
  175.     | 12: (*WITH*)
  176.             inWith := TRUE
  177. END ReadName;
  178. PROCEDURE SkipComment;    
  179. BEGIN Get;
  180.     LOOP
  181.         IF ch = "*" THEN Get; IF ch = ")" THEN Get; EXIT END
  182.         ELSIF ch = "(" THEN Get; IF ch = "*" THEN SkipComment END
  183.         ELSE Get
  184.         END
  185. END SkipComment;
  186. PROCEDURE Process (name: ARRAY OF CHAR);    
  187.     VAR ch0: CHAR; ct, res: INTEGER; par: Oberon.ParList;
  188. BEGIN
  189.     PutS(name); PutS(" profiling  "); Texts.Append(Oberon.Log, w.buf);
  190.     nextCT := 0; procCtr := -1; sp := 0;
  191.     level := 0; returnLevel := 0; inCode := FALSE; caseBegin := FALSE; inWith := FALSE; hasImports := FALSE;
  192.     Texts.OpenReader(R, src, 0); inPos := 0; outPos := 0; Get;
  193.     WHILE ch # 0X DO
  194.         CASE ch OF
  195.         | "A".."Z", "a".."z": ReadName
  196.         | '"', "'": ch0 := ch; REPEAT Get UNTIL ch = ch0; Get
  197.         | "(": Get; IF ch = "*" THEN SkipComment END
  198.         | "|": IF inCode & ~caseBegin THEN EndRange(inPos - 1); DEC(level) END;
  199.             Get
  200.         | ":": Get;
  201.             IF inCode & (ch # "=") THEN
  202.                 IF inWith THEN inWith := FALSE
  203.                 ELSE caseBegin := FALSE; DEC(inPos); DEC(outPos); StartRange(ct); INC(level)
  204.                 END
  205.             END
  206.         | 0X:
  207.         ELSE Get
  208.         END
  209.     END;
  210.     PutI(nextCT); PutS(" counters  "); Texts.WriteLn(w);
  211.     Texts.Append(Oberon.Log, w.buf);
  212.     Texts.Close(src, "Pro.Tmp");
  213.     NEW(par);
  214.     par.text := TextFrames.Text(""); par.pos := 0;
  215.     PutS("Pro.Tmp"); Texts.Append(par.text, w.buf);
  216.     par.vwr := Oberon.Par.vwr; par.frame := Oberon.Par.frame; 
  217.     Oberon.Call(compiler, par, FALSE, res)
  218. END Process;
  219. (*--------------------------------------------------------------------------------*)
  220. PROCEDURE ScanName (VAR s: Texts.Scanner);    
  221.     VAR t: Texts.Text; beg, end, time: LONGINT; v: Viewers.Viewer;
  222. BEGIN
  223.     Texts.OpenScanner (s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan (s);
  224.     IF s.class = Texts.Char THEN
  225.         IF s.c = "^" THEN
  226.             Oberon.GetSelection(t, beg, end, time);
  227.             IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END
  228.         ELSIF s.c = "*" THEN
  229.             v := Oberon.MarkedViewer();
  230.             Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s)
  231.         END
  232.     END;
  233. END ScanName;
  234. PROCEDURE Strip (VAR s: ARRAY OF CHAR);    
  235.     VAR i, j: INTEGER;
  236. BEGIN
  237.     i := 0; j := -1;
  238.     WHILE s[i] # 0X DO
  239.         IF s[i] = "." THEN j := i END;
  240.         INC(i)
  241.     END;
  242.     IF j >= 0 THEN s[j] := 0X END
  243. END Strip;
  244. PROCEDURE GetCounterData (f: CounterFrame; t: Texts.Text);    
  245.     VAR i: INTEGER;
  246.     PROCEDURE Sort(VAR a: ARRAY OF Counter; l, r: INTEGER);    
  247.         VAR i, j: INTEGER; m: LONGINT; c: Counter;
  248.     BEGIN
  249.         i := l; j := r; m := a[(i+j) DIV 2].n;
  250.         REPEAT
  251.             WHILE a[i].n > m DO INC(i) END;
  252.             WHILE a[j].n < m DO DEC(j) END;
  253.             IF i <= j THEN
  254.                 c := a[i]; a[i] := a[j]; a[j] := c; INC(i); DEC(j)
  255.             END
  256.         UNTIL i > j;
  257.         IF l < j THEN Sort(a, l, j) END;
  258.         IF i < r THEN Sort(a, i, r) END
  259.     END Sort;
  260. BEGIN
  261.     Texts.Delete(t, 0, t.len);
  262.     f.counters := SHORT(LEN(f.mod.c^)); NEW(f.c, f.counters);
  263.     FOR i := 0 TO f.counters-1 DO f.c[i] := f.mod.c[i] END;
  264.     Sort(f.c^, 0, f.counters-1);
  265.     Texts.SetFont(w, Fonts.This("Syntax10x.Scn.Fnt"));
  266.     FOR i := 0 TO f.counters-1 DO
  267.         Texts.WriteInt(w, f.c[i].n, 7); Texts.WriteLn(w)
  268.     END;
  269.     Texts.SetFont(w, Fonts.Default);
  270.     Texts.Insert(t, 0, w.buf)
  271. END GetCounterData;
  272. PROCEDURE Line (f: CounterFrame; pos: LONGINT): INTEGER;    
  273.     VAR i, x: INTEGER; lastBeg: LONGINT; c: Counter;
  274. BEGIN
  275.     i := 0; x := -1; lastBeg := -1;
  276.     WHILE i < f.counters DO (*find smallest enclosing range*)
  277.         c := f.c[i];
  278.         IF (c.beg <= pos) & (c.end >= pos) & (c.beg > lastBeg) THEN x := i; lastBeg := c.beg END;
  279.         INC(i)
  280.     END;
  281.     RETURN x
  282. END Line;
  283. (*--------------------------------------------------------------------------------*)
  284. PROCEDURE SrcHandler* (f: Display.Frame; VAR m: Display.FrameMsg);    
  285.     VAR sf: SourceFrame; cf: CounterFrame; pos, org: LONGINT; line, oldLine: INTEGER;
  286. BEGIN
  287.     sf := f(SourceFrame); cf := sf.ctrFrame;
  288.     WITH m: Oberon.InputMsg DO
  289.         IF (m.id = Oberon.track) & (m.keys # {}) & (m.X > sf.X + TextFrames.barW) THEN
  290.             oldLine := -1;
  291.             REPEAT
  292.                 pos := TextFrames.Pos(sf, m.X, m.Y);
  293.                 line := Line(cf, pos);
  294.                 IF (line >= 0) & (line # oldLine) THEN
  295.                     sf.handle(sf, neutralize);
  296.                     TextFrames.SetSelection(sf, cf.c[line].beg, cf.c[line].end);
  297.                     pos := 8*line; org := pos - 20; IF org < 0 THEN org := 0 END;
  298.                     cf.handle(cf, neutralize);
  299.                     TextFrames.Show(cf, org);
  300.                     TextFrames.SetSelection(cf, pos, pos + 7);
  301.                     oldLine := line
  302.                 END;
  303.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y);
  304.                 Input.Mouse(m.keys, m.X, m.Y)
  305.             UNTIL m.keys = {}
  306.         ELSE TextFrames.Handle(f, m)
  307.         END
  308.     ELSE TextFrames.Handle(f, m)
  309. END SrcHandler;
  310. PROCEDURE CtrHandler* (f: Display.Frame; VAR m: Display.FrameMsg);    
  311.     VAR cf: CounterFrame; pos, oldPos, org, i: LONGINT;
  312. BEGIN
  313.     cf := f(CounterFrame);
  314.     WITH m: Oberon.InputMsg DO
  315.         IF (m.id = Oberon.track) & (m.keys # {}) & (m.X > cf.X + TextFrames.barW) THEN
  316.             oldPos := -1;
  317.             REPEAT
  318.                 pos := TextFrames.Pos(cf, cf.X, m.Y);
  319.                 IF pos # oldPos THEN
  320.                     TextFrames.SetSelection(cf, pos, pos + 7); oldPos := pos
  321.                 END;
  322.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y);
  323.                 Input.Mouse(m.keys, m.X, m.Y)
  324.             UNTIL m.keys = {};
  325.             i := pos DIV 8;
  326.             org := cf.c[i].beg - 200; IF org < 0 THEN org := 0 END;
  327.             cf.srcFrame.handle(cf.srcFrame, neutralize);
  328.             TextFrames.Show(cf.srcFrame, org);
  329.             TextFrames.SetSelection(cf.srcFrame, cf.c[i].beg, cf.c[i].end)
  330.         ELSE TextFrames.Handle(f, m)
  331.         END
  332.     ELSE TextFrames.Handle(f, m)
  333. END CtrHandler;
  334. PROCEDURE GetModule* (name: ARRAY OF CHAR; VAR m: Module);    
  335. BEGIN
  336.     m := firstMod;
  337.     WHILE (m # NIL) & (m.name # name) DO m := m.next END;
  338. END GetModule;
  339. PROCEDURE Compile*;    
  340.     VAR f: TextFrames.Frame; s, s0: Texts.Scanner; v: Viewers.Viewer; t: Texts.Text; beg, end, time: LONGINT;
  341.         buf: Texts.Buffer;
  342. BEGIN
  343.     f := Oberon.Par.frame(TextFrames.Frame);
  344.     Texts.OpenScanner(s, f.text, Oberon.Par.pos);
  345.     LOOP
  346.         Texts.Scan(s); time := -1;
  347.         IF (s.class = Texts.Char) & (s.c = "^") THEN
  348.             Oberon.GetSelection(t, beg, end, time);
  349.             IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END
  350.         END;
  351.         IF s.class = Texts.Name THEN
  352.             src := TextFrames.Text(s.s); 
  353.             Process(s.s);
  354.             IF time >= 0 THEN EXIT END
  355.         ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
  356.             v := Oberon.MarkedViewer();
  357.             IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  358.                 t := v.dsc.next(TextFrames.Frame).text;
  359.                 NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, 0, t.len, buf);
  360.                 src := TextFrames.Text(""); Texts.Append(src, buf);
  361.                 Texts.OpenScanner(s0, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s0);
  362.                 Process(s0.s)
  363.             END;
  364.             EXIT
  365.         ELSE EXIT
  366.         END
  367. END Compile;
  368. PROCEDURE UseCompiler*;    
  369.     VAR s: Texts.Scanner;
  370. BEGIN
  371.     Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  372.     IF s.class = Texts.Name THEN COPY(s.s, compiler) END
  373. END UseCompiler;
  374. PROCEDURE Show*;    
  375.     VAR s: Texts.Scanner; t: Texts.Text;  m: Module; fn: Name; x, y: INTEGER;
  376.         mf: TextFrames.Frame; sf: SourceFrame; cf: CounterFrame; v: Viewers.Viewer;
  377.     PROCEDURE Append (VAR s: ARRAY OF CHAR; ext: ARRAY OF CHAR);    
  378.         VAR i, j: INTEGER;
  379.     BEGIN
  380.         i := 0; WHILE s[i] # 0X DO INC(i) END;
  381.         j := 0; WHILE ext[j] # 0X DO s[i] := ext[j]; INC(i); INC(j) END;
  382.         s[i] := 0X
  383.     END Append;
  384. BEGIN
  385.     ScanName(s);
  386.     IF s.class = Texts.Name THEN
  387.         Strip(s.s);
  388.         m := firstMod; WHILE (m # NIL) & (m.name # s.s) DO m := m.next END;
  389.         IF m = NIL THEN
  390.             Texts.WriteString(w, s.s); Texts.WriteString(w, " not found"); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  391.         ELSE
  392.             COPY(s.s, fn); Append(fn, ".Mod");
  393.             mf := TextFrames.NewMenu(fn, "System.Close  System.Copy  System.Grow  Edit.Search");
  394.             NEW(sf);
  395.             TextFrames.Open(sf, TextFrames.Text(fn), 0); sf.handle := SrcHandler;
  396.             Oberon.AllocateUserViewer(0, x, y);
  397.             v := MenuViewers.New(mf, sf, TextFrames.menuH, x, y);
  398.             COPY(s.s, fn); Append(fn, " counters");
  399.             mf := TextFrames.NewMenu(fn, "System.Close  System.Copy  System.Grow  Profiler.Update");
  400.             t := TextFrames.Text("");
  401.             NEW(cf); cf.mod := m; cf.srcFrame := sf; sf.ctrFrame := cf;
  402.             GetCounterData(cf, t);
  403.             TextFrames.Open(cf, t, 0); cf.handle := CtrHandler;
  404.             Oberon.AllocateSystemViewer(0, x, y);
  405.             v := MenuViewers.New(mf, cf, TextFrames.menuH, x, y)
  406.         END
  407. END Show;
  408. PROCEDURE Reset*;    
  409.     VAR s: Texts.Scanner; m: Module; i: LONGINT;
  410. BEGIN
  411.     ScanName(s);
  412.     IF s.class = Texts.Name THEN
  413.         Strip(s.s);
  414.         m := firstMod; WHILE (m # NIL) & (m.name # s.s) DO m := m.next END;
  415.         IF m = NIL THEN
  416.             Texts.WriteString(w, s.s); Texts.WriteString(w, " not found"); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  417.         ELSE
  418.             FOR i := 0 TO LEN(m.c^)-1 DO m.c[i].n := 0 END
  419.         END
  420.     END;
  421. END Reset;
  422. (*PROCEDURE Print*;    
  423.     VAR m: Module; i: INTEGER;
  424. BEGIN
  425.     m := firstMod;
  426.     WHILE m # NIL DO
  427.         IO.Str(m.name); IO.NL;
  428.         FOR i := 0 TO LEN(m.c^) - 1 DO
  429.             IO.Str("   "); IO.Int1(m.c[i].beg, 5); IO.Str(" -"); IO.Int1(m.c[i].end, 5); IO.Int1(m.c[i].n, 7); IO.NL
  430.         END;
  431.         m := m.next
  432. END Print;
  433. BEGIN
  434.     key[0] := "BEGIN";
  435.     key[1] := "DO";
  436.     key[2] := "ELSE";
  437.     key[3] := "ELSIF";
  438.     key[4] := "END";
  439.     key[5] := "IMPORT";
  440.     key[6] := "LOOP";
  441.     key[7] := "OF";
  442.     key[8] := "REPEAT";
  443.     key[9] := "RETURN";
  444.     key[10] := "THEN";
  445.     key[11] := "UNTIL";
  446.     key[12] := "WITH";
  447.     Texts.OpenWriter(w);
  448.     compiler := "Compiler.Compile";
  449.     firstMod := NIL;
  450.     neutralize.id := Oberon.neutralize
  451. END Profiler.
  452.